home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / textfile.swg / 0040_Good file Viewer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-24  |  3.2 KB  |  138 lines
  1. {
  2.  IP>     Does anyone have a source to a viewer out there? Im looking
  3.  IP> for one kinda like List.com or whatever.. where you can use your
  4.  IP> arrow keys to list the file.. Thanx alot!!!!!!!!!!!!!!!!!!!!
  5. }
  6.  
  7.  Program Viewer;
  8.  (*$M $800,0,$A0000 *)
  9.  
  10.  Uses
  11.     crt;
  12.  
  13.  Type    TextBlock = Array[1..16000] of ^String; { lines enough? 8-) }
  14.  
  15.  Var     VText : TextBlock;
  16.          Lines : integer;
  17.          Last  : integer;
  18.  
  19.  Procedure Init(N:string);
  20.  Var F: text;
  21.      S: String;
  22.  begin
  23.    FillChar( VText, Sizeof(Vtext), 0 );
  24.    Lines := 0;
  25.    Assign( f, N );
  26. (*$I-*)
  27.    Reset( f );
  28. (*$I+*)
  29.    If IoResult <> 0 then exit;
  30.    While ( not EOF( F ) )
  31.      AND ( Maxavail > 80 )   do  { assume a 80-Char-String }
  32.    begin
  33.       Inc( Lines );
  34.       ReadLn( F, S );
  35.       If Length(S) > 80
  36.         Then S[0] := #80;
  37.       GetMem( Vtext[Lines], 1+Length(S) );
  38.       VText[Lines]^ := S;
  39.    end;
  40.    Last := Lines;
  41.    if not eof( F )
  42.      then Write(' Sorry, only ')
  43.      else Write(' All ');
  44.    Writeln( Lines,' Lines of ', N , ' read. ');
  45.    Close( F );
  46.  end;
  47.  
  48.  Procedure Display(N:String);
  49.  Var ch : Char;
  50.      akt: integer;
  51.      Procedure Update;
  52.      Var y,i: integer;
  53.      begin
  54.        if akt > ( Last - 22 )
  55.           then akt := last - 22;
  56.        if akt < 1
  57.           then akt := 1;
  58.        y := 2;
  59.        for  i := akt to akt + 22 do
  60.        begin
  61.          gotoxy( 1, y );
  62.          ClrEol;
  63.          inc( y );
  64.          if i <= Last then write( VText[i]^ );
  65.        end;
  66.        TextAttr := $70;  (* Black on Gray *)
  67.        Gotoxy(70,25);
  68.        if akt+23 > Last
  69.          then Write(akt,'..',Last)
  70.          else Write(akt,'..',akt+22);
  71.        ClrEol
  72.      end;
  73.  begin
  74.    TextAttr := $70;  (* Black on Gray *)
  75.    ClrScr;
  76.    Gotoxy( 2, 1);
  77.    Write('The All Dancing and Singing Textfile Viewer');
  78.    Write('     Norbert Igl, 2:2453/50.3@Fido');
  79.    Gotoxy( 2,25);
  80.    while Pos('\',N) > 0 do delete(n,1,1);
  81.    for akt := 1 to length(N) do N[akt] := upcase(n[akt]);
  82.    Write('File: ',N,', ',Last,' Lines,  ');
  83.    Write( MemAvail,' Bytes free.');
  84.    Gotoxy(63,25); Write('Lines: ');
  85.    akt := 1;
  86.    repeat
  87.      TextAttr := $1F;  { white on blue }
  88.      Update;
  89.      repeat
  90.         ch := ReadKey;
  91.         if ch = #0 then
  92.         begin
  93.           ch := readkey;
  94.           case ch of
  95.           'H' : ch := #1; { up }
  96.           'P' : ch := #2; { down }
  97.           'Q' : ch := #3; { pg-up }
  98.           'I' : ch := #4; { pg-down }
  99.           'G' : ch := #5; { home }
  100.           'O' : ch := #6; { end }
  101.           else ch := #0;  { discard }
  102.         end
  103.         end
  104.      until Ch in [#27, #1..#6 ] ;
  105.      case Ch of
  106.        #1 : dec( akt );
  107.        #2 : inc( akt );
  108.        #3 : inc( akt, 22 );
  109.        #4 : dec( akt, 22 );
  110.        #5 : akt := 1;
  111.        #6 : akt := last-22;
  112.      end;
  113.   until ch=#27;
  114.  end;
  115.  
  116.  procedure CleanUp;
  117.  Var I : Integer;
  118.  begin
  119.    for I := last downto 1 do
  120.      FreeMem( Vtext[i], 1+Length(VText[i]^) );
  121.    TextAttr := 7;
  122.    ClrScr;
  123.  end;
  124.  
  125.  begin
  126.    if Paramcount <> 1 then
  127.    begin
  128.      writeln(' Usage :  VIEWER [Drive:[\Path\]] FileName.Ext');
  129.      halt
  130.    end;
  131.    Init(paramstr(1));
  132.    if Lines > 0 then
  133.    begin
  134.      Display(paramstr(1));
  135.      CleanUp
  136.    end;
  137.  end.
  138.